unit MainUnit;

interface

uses
  Classes, Windows, Variants, OleCtrls, SHDocVw;

const
  EVENT_BEFORE_NAVIGATE = 1;
  EVENT_FRAME_COMPLETE = 2;
  EVENT_DOCUMENT_COMPLETE = 3;

type
  TWebBrowserEventProc = procedure(EventCode: Integer; URL: PWideChar) of object;

  TInnoWebBrowser = class
  private
    FWebBrowser: TWebBrowser;
    FEventCallback: TWebBrowserEventProc;
    procedure OnBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant;
      var Flags: OleVariant; var TargetFrameName: OleVariant; var PostData: OleVariant;
      var Headers: OleVariant; var Cancel: WordBool);
    procedure OnDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
  public
    constructor Create(ParentWnd: HWND; Left, Top, Width, Height: Integer;
      CallbackProc: TWebBrowserEventProc);
    destructor Destroy; override;
    procedure Show(Visible: Boolean);
    procedure Navigate(URL: PWideChar);
    function GetOleObject: Variant;
  end;

procedure WebBrowserCreate(ParentWnd: HWND; Left, Top, Width, Height: Integer;
  CallbackProc: TWebBrowserEventProc); stdcall;
procedure WebBrowserDestroy; stdcall;
procedure WebBrowserShow(Visible: Boolean); stdcall;
procedure WebBrowserNavigate(URL: PWideChar); stdcall;
function WebBrowserGetOleObject: Variant; stdcall;

implementation

var
  InnoWebBrowser: TInnoWebBrowser;

procedure WebBrowserCreate(ParentWnd: HWND; Left, Top, Width, Height: Integer;
  CallbackProc: TWebBrowserEventProc);
begin
  WebBrowserDestroy;
  InnoWebBrowser := TInnoWebBrowser.Create(ParentWnd, Left, Top, Width, Height, CallbackProc);
end;

procedure WebBrowserDestroy;
begin
  InnoWebBrowser.Free;
  InnoWebBrowser := nil;
end;

procedure WebBrowserShow(Visible: Boolean);
begin
  if Assigned(InnoWebBrowser) then
    InnoWebBrowser.Show(Visible);
end;

procedure WebBrowserNavigate(URL: PWideChar);
begin
  if Assigned(InnoWebBrowser) then
    InnoWebBrowser.Navigate(URL);
end;

function WebBrowserGetOleObject: Variant;
begin
  Result := NULL;
  if Assigned(InnoWebBrowser) then
    Result := InnoWebBrowser.GetOleObject;
end;

{ TInnoWebBrowser }

constructor TInnoWebBrowser.Create(ParentWnd: HWND; Left, Top, Width, Height: Integer;
  CallbackProc: TWebBrowserEventProc);
begin
  FWebBrowser := TWebBrowser.Create(nil);
  FWebBrowser.ParentWindow := ParentWnd;
  FWebBrowser.Left := Left;
  FWebBrowser.Top := Top;
  FWebBrowser.Width := Width;
  FWebBrowser.Height := Height;
  FWebBrowser.OnBeforeNavigate2 := OnBeforeNavigate2;
  FWebBrowser.OnDocumentComplete := OnDocumentComplete;

  FEventCallback := CallbackProc;
end;

destructor TInnoWebBrowser.Destroy;
begin
  FWebBrowser.Free;
  inherited;
end;

procedure TInnoWebBrowser.Navigate(URL: PWideChar);
begin
  FWebBrowser.Navigate(URL);
end;

function TInnoWebBrowser.GetOleObject: Variant;
begin
  Result := FWebBrowser.OleObject;
end;

procedure TInnoWebBrowser.OnBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL,
  Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);
var
  URLString: WideString;
begin
  if Assigned(FEventCallback) then
  begin
    URLString := URL;
    FEventCallback(EVENT_BEFORE_NAVIGATE, PWideChar(URLString));
  end;
end;

procedure TInnoWebBrowser.OnDocumentComplete(ASender: TObject; const pDisp: IDispatch;
  var URL: OleVariant);
var
  URLString: WideString;
begin
  if Assigned(FEventCallback) then
  begin
    URLString := URL;
    if pDisp <> TWebBrowser(ASender).ControlInterface then
      FEventCallback(EVENT_FRAME_COMPLETE, PWideChar(URLString))
    else
      FEventCallback(EVENT_DOCUMENT_COMPLETE, PWideChar(URLString));
  end;
end;

procedure TInnoWebBrowser.Show(Visible: Boolean);
begin
  if Visible then
    FWebBrowser.Show
  else
    FWebBrowser.Hide;
end;

end.
